home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / browse.pas < prev    next >
Pascal/Delphi Source File  |  1990-06-25  |  9KB  |  276 lines
  1. program lit;
  2.  
  3.  
  4.  
  5.  
  6. uses crt,dos;
  7.  
  8. const    pgup = #73;
  9.          fleh = #72;
  10.          pgdn = #81;
  11.          fleb = #80;
  12.          home_= #71;
  13.          end_ = #79;
  14.          esc  = 27;
  15.          ret  = 13;
  16.          dl : Char = 'M';
  17.          ls : Char = '5';
  18.          rs : Char = 'F';
  19.          up : Char = #24;
  20.          dn : Char = #25;
  21.          sl : Char = 'D';
  22.          blanc ='                    ';
  23.          max_char_par_ligne  = 79;
  24.          max_ligne_par_page  = 22;
  25.          nom_du_fichier : string[30]='d:\compus\astroc.txt';
  26.          ecran ='monoherc';
  27.  
  28. type
  29.  
  30.           pagetype =  array[1..max_ligne_par_page] of string[max_char_par_ligne];
  31.  
  32.           dll      = ^ dlr;
  33.           dlr      =  record
  34.                        no     :integer;
  35.                        page   :pagetype;
  36.                        suivant:dll;
  37.                        prede  :dll;
  38.                       end;
  39.  
  40.  
  41. var  fi       : text;
  42.      pred,
  43.      tempo  ,
  44.      debut,t    : dll;
  45.      r,r_        : char;
  46.      page_temp: pagetype;
  47.  
  48.      i,j,k      : integer;
  49.      ou ,npagetot        : integer;
  50.      by : real;
  51.      mlp,mcl,orr:real;
  52.      fk           : boolean;
  53.  
  54. {---------------------------------------------------------------------}
  55.  
  56. procedure scr(npagetot :integer);
  57. var
  58.      j:integer;
  59. begin
  60.                         window(1,24,80,25);
  61.                         clrscr;
  62.                         textcolor(15);
  63.                         textbackground(0);
  64.                         gotoxy(1,1); for j:=1 to 80 do write(sl);
  65.                         gotoxy(1,2); write('Pgup  ',#24);
  66.                         GotoXY(8,1); write('B');
  67.                         GotoXY(8,2); write('3');
  68.                         gotoxy(9,2); write ('Pgdn  ',#25);
  69.                         GotoXY(16,1); write('B');
  70.                         GotoXY(16,2); write('3');
  71.                         gotoxy(17,2); write('Home  ');
  72.                         GotoXY(23,1); write('B');
  73.                         GotoXY(23,2); write('3');
  74.                         gotoxy(24,2); write('End    ');
  75.                         GotoXY(31,1); write('B');
  76.                         GotoXY(31,2); write('3');
  77.                         gotoxy(32,2); write('Esc    ');
  78.                         GotoXY(42,1); write('B');
  79.                         GotoXY(42,2); write('3');
  80.                         gotoxy(43,2); write('Page:');write('    ');write('/');
  81.                         gotoxy(53,2); write(npagetot:5);
  82.                         GotoXY(58,1); write('B');
  83.                         GotoXY(58,2); write('3');
  84.                         if length(nom_du_fichier) > 18 then begin
  85.                                        for i:=1 to 18 do write(nom_du_fichier[i]);
  86.                                        write('...');
  87.                                        end
  88.                         else  write(nom_du_fichier);
  89.                         textcolor(7);
  90.                         textbackground(0);
  91.                         window(1,1,80,23);
  92.  
  93.  
  94. end;
  95. {---------------------------------------------------------------------}
  96.  
  97. procedure a_jour(num :integer);
  98. var x,y :integer;
  99.     s   : char;
  100. begin
  101. x := wherex; y := wherey;
  102. window(48,24,51,25);
  103.  
  104. textcolor(7);
  105. textbackground(0);
  106. gotoxy(1,2);
  107. clreol;
  108. write( num :3 );
  109. window(1,1,80,23);
  110.  
  111. end;
  112.  
  113.  
  114.  
  115. {-------------------------------------------------------------------}
  116.  
  117. procedure curseur(size:char);
  118.  
  119. var regis : registers;
  120.  
  121.  
  122. begin
  123.  
  124.   size := upcase (size);
  125.   if ecran = 'Monoherc' then
  126.     i := 6
  127.   else
  128.     i := 6;{0 initialement}
  129.   regis.ah := $01;
  130.  
  131.   if size ='O' then
  132.      begin
  133.       regis.ch :=$20;
  134.       regis.cl :=$00;
  135.      end
  136.   else  if size ='B' then
  137.                           begin
  138.                            regis.ch := 0;
  139.                            regis.cl := 7 +i;
  140.                           end
  141.         else  begin
  142.                regis.ch := 6 + i;
  143.                regis.cl := 7 + i;
  144.               end;
  145. intr($10,regis);
  146.  
  147. end;
  148. {-------------------------------------------------------------------}
  149. procedure creer_liste_double(VAR npagetot :integer);
  150. begin
  151. k:=1;
  152. ou :=1;
  153. clrscr;
  154. mlp :=max_ligne_par_page;
  155. mcl :=max_char_par_ligne;
  156. assign(fi,nom_du_fichier); reset(fi);
  157.  
  158.  
  159. debut := nil;
  160. while not(eof(fi))  do begin
  161.                        if debut = nil then begin
  162.                                               for j := 1 to max_ligne_par_page do
  163.                                               readln(fi,page_temp[j]);
  164.                                               new(tempo);
  165.  
  166.                                               tempo^.no:=ou;
  167.                                               debut :=tempo;
  168.                                               pred := tempo;
  169.                                               tempo^.suivant := nil;
  170.                                               tempo^.prede := nil;
  171.                                               for j := 1 to max_ligne_par_page do
  172.                                               tempo^.page[j]    := page_temp[j] ;
  173.                                             end
  174.  
  175.                        else begin
  176.                              for j := 1 to max_ligne_par_page do
  177.                              readln(fi,page_temp[j]);
  178.                              k:= k+1;
  179.                              ou := ou+1;
  180.  
  181.                              pred := tempo;
  182.                              new(tempo);
  183.                              tempo^.no:=ou;
  184.                              pred^.suivant := tempo;
  185.                              tempo^.prede  := pred;
  186.                              tempo^.suivant:= nil;
  187.                              for j := 1 to max_ligne_par_page do
  188.                              tempo^.page[j]    := page_temp[j] ;
  189.                              pred:= tempo;
  190.                             end;
  191.                             orr :=ou;
  192.  
  193.                         by := orr*mlp*mcl;
  194.                         gotoxy(36,8); write('Pegase (c).');
  195.                         gotoxy(30,10);write('Lignes lues :     ');clreol;write(max_ligne_par_page*ou);
  196.                         gotoxy(30,12);write('Bytes  lus  :');clreol;write(by :10:0);
  197.                         gotoxy(30,14);write('KBytes lus  :');clreol;write(by/1024 :10:2);
  198.                         gotoxy(30,16);write('Tas (Bytes) :');clreol;write( maxavail:10);
  199.                         gotoxy(30,18);write('Tas (KBytes):');clreol;write( maxavail/1024 :10:2);
  200.  
  201.                        end;
  202.  
  203. tempo^.suivant := debut;
  204.  
  205. debut^.prede   := tempo;
  206. close(fi);
  207. npagetot := k;
  208.  
  209.  
  210. end;
  211.  
  212. {-------------------------------------------------------------------}
  213. {main}
  214.  
  215. begin
  216.  
  217. textcolor(15);
  218. textbackground(0);
  219. curseur('o');
  220.  
  221. creer_liste_double(npagetot);
  222. scr(npagetot);
  223. r:=' ';
  224. new(tempo);
  225. tempo :=debut;
  226. pred  :=nil;
  227.  
  228.                          repeat
  229.                          if tempo <> nil then begin
  230.  
  231.                         textcolor(0);
  232.                         textbackground(7);
  233.                         clrscr;
  234.  
  235.  
  236.                         for j := 1 to max_ligne_par_page do
  237.                         writeln(tempo^.page[j]);
  238.                         a_jour(tempo^.no);
  239.                         window(1,1,80,23);
  240.  
  241.                          fk := false;
  242.                            r := readkey;
  243.                            if r = #0 then  begin
  244.                                           fk := true;
  245.                                             case readkey of
  246.  
  247.                                           fleb, pgdn  :begin
  248.                                                    tempo := tempo^.suivant;
  249.                                                    end;
  250.                                            fleh, pgup  : begin
  251.                                                     tempo := tempo^.prede;;
  252.                                                     end;
  253.                                             home_ : tempo := debut;
  254.                                             end_  : begin
  255.                                                     for  i:= 1 to (npagetot-tempo^.no) do
  256.                                                     tempo := tempo